Optional Collisions.f

Requires FixedPoint
Requires SORA\Transformations
Requires Dorothy

Only Forth Definitions

{
Notes

The normal usage is with fixed point numbers, but integers will work too, so long as shape coordinations and transform positions are all integers.

TO DO:
   pre-transform shapes to get some extra speed
   non-aligned collisions
   faster OVERLAP?
   feedback - which side of each shape was "hit" and by how much

Testing

BOX-BOX - OK
POINT-BOX - OK
POINT-OVAL - OK
BOX-OVAL - OK
OVAL-OVAL - OK

}

: overlap? ( xyxy xyxy -- f )
   2swap 2rot rot swap > -rot > or >r
   rot < -rot swap < or r> or not ;

: in? ( xyxy  xy -- flag )
   2>r -1 dup 2+  2r> 2dup overlap? ;

: area
   2over 2+ ;

Type: Shape
   int.field x1
   int.field y1
   int.field x2
   goback int.field rx
   int.field y2
   goback int.field ry
End-type

shape.ref s1
shape.ref s2
transform.ref t1
transform.ref t2

: box-box-aligned  ( transform1 shape1 transform2 shape2 -- flag )
   to s2 to t2 to s1 to s1
   s1.x1.2@ t1.2transform-aligned
   s1.x2.2@ t1.2transform-aligned
   s2.x1.2@ t2.2transform-aligned
   s2.x2.2@ t2.2transform-aligned overlap? ;

: point-box-aligned   ( x. y. transform1 shape1 -- flag )
   to s1 to s1
   2>r
   s1.x1.2@ t1.2transform-aligned
   s1.x2.2@ t1.2transform-aligned 2r> in? ;

: point-oval-aligned   ( x. y. transform1 shape1 -- flag )
   to s1 to s1
   s1.x1.2@  t1.pos.2@  2+  2-    \ point is now transformed into the oval's space
   s1.x2.2@  t1.scale.2@ 2mul   \ scale radii
   within-ellipse? ;

: box-oval-aligned   (  transform1 shape1 transform2 shape2 -- flag )
   to s2 to t2 to s1 to s1
   s1.x1.2@             t1.2transform-aligned       t2 s2 point-oval-aligned ?dup ?exit  \ top-left of rectangle is in the oval
   s1.x2 @  s1.y1.@     t1.2transform-aligned       t2 s2 point-oval-aligned ?dup ?exit  \ top-right of rectangle is in the oval
   s1.x2.2@             t1.2transform-aligned       t2 s2 point-oval-aligned ?dup ?exit  \ bottom-right of rectangle is in the oval
   s1.x1 @  s1.y2.@     t1.2transform-aligned       t2 s2 point-oval-aligned ?dup ?exit  \ bottom-left of rectangle is in the oval
   s2.x1.2@ s2.y2.@ +   t2.2transform-aligned       t1 s1 point-box-aligned  ?dup ?exit  \ bottom-side of oval is in the box
   s2.x1.2@ s2.y2.@ -   t2.2transform-aligned       t1 s1 point-box-aligned  ?dup ?exit  \ top-side  of oval is in the box
   s2.x1.2@ s2.x2.@ u+ t2.2transform-aligned        t1 s1 point-box-aligned  ?dup ?exit  \ right-side of oval is in the box
   s2.x1.2@ s2.x2.@ negate u+ t2.2transform-aligned t1 s1 point-box-aligned  ?dup ?exit  \ left-side of oval is in the box
   s2.x1.2@             t2.2transform-aligned       t1 s1 point-box-aligned  ?dup ?exit  \ center of oval is in the box
   false ;

Shape.make temp1
Shape.make temp2

: oval-oval-aligned   (  transform1 shape1 transform2 shape2 -- flag )
   to s2 to t2 to s1 to s1
   s1.x1.2@   s1.x2.2@ 2-   temp1.x1.2!     \ top-left of oval
   s1.x2.2@   temp1.x2.2!                      \ bottom-right of oval
   s2.x1.2@   s2.x2.2@ 2-   temp2.x1.2!     \ top-left of oval
   s2.x2.2@   temp2.x2.2!                      \ bottom-right of oval
   t1 temp1 t2 temp2 box-box-aligned not if false exit then    \ early out
   0.0  16 0 do    s1.x2.2@ third  ellipse-point   s1.x1.2@ 2+  t1.2transform-aligned    t2 s2 point-oval-aligned
      ?dup if unloop nip exit then  22.50 +  loop  drop false ;

: circle-circle  (  transform1 shape1 transform2 shape2 -- flag )
   to s2 to t2 to s1 to s1
   s1.x1.2@ t1.2transform-aligned
   s2.x1.2@ t2.2transform-aligned  2proximity  s1.x2.@  s2.x2.@ +  < ;
